PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/mkfmx.exe/MKFMX.PAS

Pascal/Delphi Source File | 1992-11-21 | 5.6 KB | 237 lines

{$A-,B-,D-,F+,G+,I-,L-,N-,R-,S-,V-,W-,X+}
{$M 1024,0}
library UFmExtD;

uses wintypes,winprocs,win31,strings;

const
  Aplname='MkFmX';

  Menu_Text_Len   = 40;

  fmMenu_First    = 1;
  fmMenu_Last   = 99;

  fmEvent_Load    = 100;
  fmEvent_Unload    = 101;
  fmEvent_InitMenu  = 102;
  fmEvent_User_Refresh  = 103;
  fmEvent_SelChange = 104;

  fmFocus_Dir   = 1;
  fmFocus_Tree    = 2;
  fmFocus_Drives    = 3;
  fmFocus_Search    = 4;

  fm_GetFocus   = wm_User + $0200;
  fm_GetDriveInfo   = wm_User + $0201;
  fm_GetSelCount    = wm_User + $0202;
  fm_GetSelCountLFN = wm_User + $0203;  { LFN versions are odd }
  fm_GetFileSel   = wm_User + $0204;
  fm_GetFileSellFN  = wm_User + $0205;  { LFN versions are odd }
  fm_Refresh_Windows  = wm_User + $0206;
  fm_Reload_Extensions  = wm_User + $0207;

type
  PFMS_GetFileSel = ^TFMS_GetFileSel;
  TFMS_GetFileSel = record
    wTime: Word;
    wDate: Word;
    dwSize: Longint;
    bAttr: Byte;
    szName: array[0..259] of Char;   { always fully qualified }
  end;

  PFMS_GetDriveInfo = ^TFMS_GetDriveInfo;    { for drive }
  TFMS_GetDriveInfo = record
    dwTotalSpace: Longint;
    dwFreeSpace: Longint;
    szPath: array[0..259] of Char;   { current directory }
    szVolume: array[0..13] of Char;    { volume label }
    szShare: array[0..127] of Char;    { if this is a net drive }
  end;

  PFMS_Load = ^TFMS_Load;
  TFMS_Load = record
    dwSize: Longint;       { for version checks }
    szMenuName: array[0..Menu_Text_Len - 1] of Char;  { output }
    Menu: HMenu;           { output }
    wMenuDelta: Word;      { input }
  end;

Function FmExtensionProc(window:hwnd; wparam:word; Lparam:longint):Longint;
export;
forward;

exports
 FmExtensionProc index 1;

{***************************** implementation *******************}

type Titem=record
            title:array[0..15] of char;
            exec :array[0..63] of char;
            wdir :array[0..63] of char;
            pmode:char;
           end;

     titemarray=array[1..99] of titem;

var Mymenu:hmenu;
    pitem:^titemarray;
    nitem:integer;

Function FmExtensionProc(window:hwnd; wparam:word; Lparam:longint):Longint;

 procedure doload;
  var data:array[0..79] of  char;
      i,j:integer;
      p:pchar;
      a:string[9];

  function GetPstring(name,data:pchar):boolean;
   begin
    getPstring:=getprivateprofilestring(Aplname,name,'',data,78,'winfile.ini')<>0
   end;

  procedure getword(var p:pchar; data:pchar; max:integer);
   var p1:pchar;
   begin
    if p=nil then exit;
    p1:=strscan(p,',');
    if p1<>nil then
     begin
      p1^:=#0;
      inc(p1)
     end;
    strlcopy(data,p,max);
    p:=p1
   end;

  begin
   nitem:=0;
   with pfms_load(lparam)^ do
    begin
     dwsize:=sizeof(tfms_load);
     if not getPstring('MenuName',data) then exit;
     strlcopy(szmenuname,data,menu_text_len);
     if not getPstring('programs',data) then exit;
     val(data,nitem,i);
     if nitem=0 then exit;
     Mymenu:=createpopupmenu;
     menu:=mymenu;
    end;
   i:=nitem*sizeof(titem);
   getmem(pitem,i);
   fillchar(pitem^,i,0);
   for i:=1 to nitem do with pitem^[i] do
    begin
     str(i,a);
     if getPstring(strpcopy(@a,a),data) then
      begin
       p:=data;
       getword(p,title,15);
       getword(p,exec,63);
       getword(p,wdir,63);
       if p<>nil then pmode:=upcase(p^) else pmode:='S';
       if title[0]='_' then
        begin
         appendmenu(mymenu,mf_separator,0,nil);
         strcopy(title,@title[1]);
        end;
       appendmenu(mymenu,mf_string,i,title);
      end;
    end;
   FmExtensionProc:=mymenu;
  end;

 procedure DoUnload;
  begin
   destroymenu(mymenu);
   freemem(pitem,sizeof(titem)*nitem);
  end;

 procedure DoExec(which:integer);

  const maxlen=512;

  var i,j,n,L:integer;
      psel:pfms_getFilesel;
      CmdLine:pchar;

  procedure SpecialCommand(what:pchar);
   begin
    if stricomp(what,'@RELOAD')=0 then
     postmessage(window,fm_reload_extensions,0,0)
    else messagebox(window,what,'Unknown special command',
                    mb_ok or Mb_iconStop);
   end;

  begin {doexec}
   new(psel);
   getmem(cmdline,maxlen);
   with pitem^[which],psel^ do
    if exec[0]='@' then specialcommand(exec)
    else
     begin
      if wdir[0]<>#0 then chdir(wdir);
      n:=sendmessage(window,fm_getselcount,0,0);
      if (n=0) or (pmode='N') then winexec(exec,sw_normal)
      else if pmode='M' then
       begin
        strcopy(cmdline,exec);
        L:=strlen(exec);
        for i:=0 to n-1 do
         begin
          sendmessage(window,fm_getfilesel,i,longint(psel));
          j:=strlen(szname)+1;
          if (L+j)<maxlen then
           begin
            strcat(cmdline,' ');
            strcat(cmdline,szname);
            inc(L,j)
           end;
         end;
        winexec(cmdline,sw_normal);
       end
      else for I:=0 to n-1 do
       begin
        sendmessage(window,fm_getfilesel,i,longint(psel));
        strcopy(cmdline,exec);
        strcat(cmdline,' ');
        strcat(cmdline,szname);
        winexec(cmdline,sw_normal);
       end;
     end;
   freemem(cmdline,maxlen);
   dispose(psel);
  end;

 begin {fmextensionproc}
  FmExtensionproc:=0;
  case wparam of
   fmevent_Load:DoLoad;
   fmevent_unload:DoUnLoad;
   else if (wparam>0) and (wparam<=nitem) then DoExec(wparam);
  end;
 end;

begin
end.

format of profile:
[MkFmX]
menuname=Extensions
programs=4
1=Notepad,notepad.exe
2=Ms,Ms.exe,,m
3=_Notebook,NoteBook.exe
4=_Viewer,Fview.exe

_=draw separator

internal commands:

@reload